Problema 1: * Crear una ciudad cuadrada donde cada lado tiene tamaño D con distribución uniforme de personas.
Se definió una población de 500 individuos, es decir, \(N = 500\). La ciudad se encuentra modela por un cuadrando de 10 unidades de lado, teniendo \(100 u^2\) de área.
Crear un arreglo de posiciones x, y de posiciones y considerando N personas. Asignar una posición inicial para cada una de las personas de la población por medio de un número aleatorio uniforme.
Se considero un arreglo de coordenadas \((x,y)\) definidas en en intervalo [D,D].
#Definimos al número N de personas a considerar
N = 500
x <- c(runif(N, min=0, max=10))
y <- c(runif(N,min=0,max=10))
coordenadas <- data.frame(x,y)
f <- stri_rand_strings(N, 5)
#Graficamos la distibución de las personas en la ciudad
plot(coordenadas,
main = "Distribución de las personas en la ciudad",
xlab = "D",
ylab = "D")
#Añadimos un ID diferente a cada persona
coordenadas <- tibble::rowid_to_column(coordenadas, "ID")
Dado un valor inicial de N, crear 3 variables para contar el número inicial de infectados, de susceptibles y de recuperados. Las variables deben ser tales que \(N=I+S+R\) y que haya por lo menos una persona infectada.Inicialmente no hay recuperados \((R=0)\).
#Definimos quienes son nuestras variables. Cumpliendo que N = I + S + R.
S <- 499
I <- 1
R <- 0
N <- S + R + I
Crear 2 variables para definir el de infección \(r\), que representará la distancia para poderse infectar,\(r=0.6\),y para la razón de recuperación.
#Ratio de contagio
r <- 0.6
#Ratio de recuperación. USando la propuesta en modelos anteriores.
gama <- 0.3
Crear una variable categórica (factor variable) que represente el estado de la persona (suceptible, infectada o recuperada).
#Creamos la variable categorica de estado. Asignamos la infección de forma al azar.
estado <- ifelse(coordenadas$ID == sample(1:N,I),'infectado','susceptible')
#Indexamos la variable a nuestro dataframe
coordenadas$Estado <- estado
Escribir una función que revise la distancia euclidiana entre dos puntos y regrese TRUE (o 1) si la distancia es menor que r y regrese FALSE (o 0) si la distancia es mayor o igual que r.
Para esta función se utiliza la deducción de la que se obtiene del Teorema de Pitágoras.
#Función que calcula si la distancia euclidia entre 2 puntos coordenados (x,y) es menor que el ratio de contagio r.
distancia_euclidia <- function(x1,y1,x2,y2){
distancia <- sqrt((x2-x1)^2 + (y2-y1)^2)
if (distancia <= r){
return(TRUE)
}else{
return(FALSE)
}
}
#Hacemos una copia de las coordenadas iniciales.Iremos concatenando los nuevos datos a este dataframe.
coordenadas2 <- coordenadas
#modificaciones a lo yolo
coordenadas2$I <- rep(0,nrow(coordenadas))
#Rratio <- runif(nrow(coordenadas))
#coordenadas$ratio <-Rratio
tiempo <- c(1:10)
for (i in tiempo){
#Creamos dos vectores de tamaño N con los desplazamientos
x1 <- c(runif(N, min=0, max=10))
y1 <- c(runif(N,min=0,max=10))
#Asignamos números aleatorios a cada contagiado.
#Rratio <- runif(nrow(coordenadas))
#coordenadas$ratio <-Rratio
#Checar quienes están infectados
inf = subset(coordenadas, Estado == 'infectado')
sus = subset(coordenadas, Estado == 'susceptible')
recu = subset(coordenadas, Estado == 'recuperado')
#Método de contagio
for (k in (1:nrow(inf))){
x0 <- inf[k,2]
y0 <- inf[k,3]
for (j in (1:nrow(coordenadas))){
t <- distancia_euclidia(coordenadas[j,2],coordenadas[j,3],x0,y0)
if(t == TRUE){
coordenadas[j,4]='infectado'
}
}
}
Rratio <- runif(nrow(inf))
inf$ratio <-Rratio
#Método de recuperación
for (v in (1:nrow(inf))){
ratio_t <- inf[v,5]
if (ratio_t <= gama){
id <- inf[v,1]
coordenadas[id,4] = 'recuperado'
}
}
coordenadas$x <- x1
coordenadas$y <- y1
coordenadas$ratio <- NULL
coordenadas$I <- rep(i,nrow(coordenadas))
coordenadas2 <- rbind(coordenadas2,coordenadas)
coordenadas$I <- NULL
}
fig <- coordenadas2 %>%
plot_ly(
x = ~x,
y = ~y,
color = ~Estado,
frame = ~I,
type = 'scatter',
mode = 'markers',
text = ~ID,
hoverinfo = "text"
)
#fig <- fig %>%
#%animation_opts(
#1000, easing = "elastic", redraw = FALSE
#)
fig
## Warning: `arrange_()` is deprecated as of dplyr 0.7.0.
## Please use `arrange()` instead.
## See vignette('programming') for more help
## This warning is displayed once every 8 hours.
## Call `lifecycle::last_warnings()` to see where this warning was generated.
## Warning in p$x$data[firstFrame] <- p$x$frames[[1]]$data: número de items para
## para sustituir no es un múltiplo de la longitud del reemplazo